PC Answers 1995 May/PC Answers CD-ROM 7 (Future Publishing) (May 1995).iso/vbits/code/cert/trk3_eg/error/fil_open/textedit.frm

Visual Basic Form | 1994-02-17 | 9.4 KB | 295 lines

VERSION 2.00
Begin Form frmTextEdit
   Caption         =   "Text Editor"
   ClientHeight    =   3405
   ClientLeft      =   750
   ClientTop       =   2100
   ClientWidth     =   7680
   Height          =   4095
   Left            =   690
   LinkMode        =   1  'Source
   LinkTopic       =   "Form2"
   ScaleHeight     =   3405
   ScaleWidth      =   7680
   Top             =   1470
   Width           =   7800
   Begin TextBox txtEditor
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   8.25
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   2535
      Left            =   240
      MultiLine       =   -1  'True
      ScrollBars      =   3  'Both
      TabIndex        =   0
      Top             =   240
      Width           =   2295
   End
   Begin Menu mnuFile
      Caption         =   "&File"
      Begin Menu mnuFileNew
         Caption         =   "&New"
      End
      Begin Menu mnuFileOpen
         Caption         =   "&Open..."
      End
      Begin Menu mnuFileSave
         Caption         =   "&Save"
      End
      Begin Menu mnuFileSaveAs
         Caption         =   "Save&As..."
      End
      Begin Menu mnuSep1
         Caption         =   "-"
      End
      Begin Menu mnuFileExit
         Caption         =   "E&xit"
      End
   End
   Begin Menu mnuEdit
      Caption         =   "&Edit"
      Begin Menu mnuEditCut
         Caption         =   "Cu&t"
         Enabled         =   0   'False
         Shortcut        =   ^X
      End
      Begin Menu mnuEditCopy
         Caption         =   "&Copy"
         Enabled         =   0   'False
         Shortcut        =   ^C
      End
      Begin Menu mnuEditPaste
         Caption         =   "&Paste"
         Enabled         =   0   'False
         Shortcut        =   ^V
      End
      Begin Menu mnuSep2
         Caption         =   "-"
      End
      Begin Menu mnuEditClearClip
         Caption         =   "C&lear Clipboard"
         Shortcut        =   ^L
      End
   End
Option Explicit
Sub Form_QueryUnload (cancel As Integer, UnloadMode As Integer)
    'See if it's OK to nuke the user's changes (if any)
    If Not OKtoNuke("Text has changed. Save before terminating?") Then
        cancel = True
    End If
End Sub
Sub Form_Resize ()
    txtEditor.Move Me.ScaleLeft, Me.ScaleTop, Me.ScaleWidth, Me.ScaleHeight
End Sub
Sub Form_Unload (cancel As Integer)
    'Terminate the application
    End
End Sub
Sub mnuEdit_Click ()
    Const CF_TEXT = 1
    'Paste is only enabled if there's text in the paste buffer.
    mnuEditPaste.Enabled = clipboard.GetFormat(CF_TEXT)
    'Cut and copy are only enabled if something is selected.
    If txtEditor.SelLength <> 0 Then
        mnuEditCut.Enabled = True
        mnuEditCopy.Enabled = True
    Else
        mnuEditCut.Enabled = False
        mnuEditCopy.Enabled = False
    End If
End Sub
Sub mnuEditClearClip_Click ()
    'Clear the Clipboard
    clipboard.Clear
End Sub
Sub mnuEditCopy_Click ()
    'Place the selected text into the clipboard
    clipboard.Clear
    clipboard.SetText txtEditor.SelText
End Sub
Sub mnuEditCut_Click ()
    clipboard.Clear
    'Place the selected text into the clipboard
    clipboard.SetText txtEditor.SelText
    'Cut the selected text out of the source textbox
    txtEditor.SelText = ""
End Sub
Sub mnuEditPaste_Click ()
    'Place the clipboard text into the Active TextBox
    txtEditor.SelText = clipboard.GetText()
End Sub
Sub mnuFileExit_Click ()
    'See if it's OK to nuke the user's changes (if any)
    If Not OKtoNuke("Text has changed. Save before terminating?") Then
        Exit Sub
    End If
    'End Application
    End
End Sub
Sub mnuFileNew_Click ()
    'Make sure the file hasn't changed
    If Not OKtoNuke("Text has changed. Save before opening a new file?") Then
        Exit Sub
    End If
    'Reset the contents of the textbox
    txtEditor.Text = ""
    'Reset the file name to blank
    fname = ""
    'Reset the change flag to 0
    dirtyflag = False
    ' Reset the form caption
    frmTextEdit.Caption = ""
End Sub
Sub mnuFileOpen_Click ()
    Const ILLEGAL_FUNCTION_CALL = 5
    Const OUT_OF_MEMORY = 7
    Const NO_STRING_SPACE = 14
    Dim KeyPressed As Integer
    Dim fhandle As Integer
    Dim mymsg As String
    Dim msgtype As Integer
    Dim msgtitle As String
    'See if it's OK to nuke the user's changes (if any)
    If Not OKtoNuke("Text has changed. Save before opening a new file?") Then
        Exit Sub
    End If
    'Allow the user to select a file to open (or choose cancel)...
    frmFileList.Show MODAL
    'Make sure the user selected a file
    If fname = "" Then Exit Sub
    'You now have a filename
    'Get a file number
    fhandle = FreeFile
    'Set the Open error handling trap
    On Error GoTo OpenError
    'Open the file for sequential input...
    Open fname$ For Input As fhandle
    'Change the mouse pointer to an hourglass
    MousePointer = HOURGLASS
    'Put file into text box
    txtEditor.Text = Input$(LOF(fhandle), fhandle)
    'Set the change flag indicator (no changes yet)
    dirtyflag = False
    'Set the form caption to the filename
    frmTextEdit.Caption = fname$
FileTooBig:
    'Reset the mouse pointer back to normal
    MousePointer = DEFAULT
    'Close the file
    Close fhandle
    Exit Sub
OpenError:
    msgtype = RETRYCANCEL + WARNINGMESSAGE + SECONDBUTTON
    msgtitle = "FILE SIZE ERROR"
    'Determine the File Error
    Select Case Err
        Case ILLEGAL_FUNCTION_CALL
            mymsg = "File's WAY too big."
        Case OUT_OF_MEMORY
            mymsg = "Not enough memory."
        Case NO_STRING_SPACE
            mymsg = "Out of string space."
        Case Else    'Any other error
            mymsg = "Some other error " + Str$(Err) + " " + Error$
            msgtype = OK
            msgtitle = "Unknown Error"
    End Select

    KeyPressed = MsgBox(mymsg, msgtype, msgtitle)
    Select Case KeyPressed
        Case KEYRETRY               'Try again
            Resume
        Case KEYCANCEL              'Cancel attempt to read file
            Resume FileTooBig
        Case Else                   'Unexpected key value
            mymsg = "Unexpected results, key = " + Str$(KeyPressed)
            msgtype = CRITICAL
            msgtitle = "KEY ERROR"
            MsgBox mymsg, msgtype, msgtitle
            'End the Application
            End
    End Select
End Sub
Sub mnuFileSave_Click ()
    Dim fhandle As Integer
    Dim Match As String
    Dim ans As Integer
    'If this is a new file with no filename, show the Save As Form...
    If fname = "" Then
        frmSaveAs.Show MODAL
        'Make sure the user picked a filename
        If fname = "" Then Exit Sub
    End If
    'If the file already exists, allow the user to not overwrite it...
    Match = Dir$(fname)
    If Match <> "" Then
        ans = MsgBox("File, '" + fname + "' already exists.  Overwrite it?", YESNO + WARNINGQUERY + FIRSTBUTTON, "File Exists")
        'Check the user response
        If ans = KEYNO Then     ' User pressed no
            Exit Sub
        End If
    End If
    'Save the file:

    'Get a free file number, open the file for sequential output,
    fhandle = FreeFile
    Open fname For Output As fhandle

    'Write the contents of the text box to the file
    Print #fhandle, txtEditor.Text

    'Close the file
    Close fhandle
    'Reset the change flag
    dirtyflag = False
    'Reset the form caption
    frmTextEdit.Caption = fname
End Sub
Sub mnuFileSaveAs_Click ()
    'Allow the user to pick a filename (or choose cancel)...
    frmSaveAs.Show MODAL
    'Check to see if user pressed cancel
    If fname = "" Then Exit Sub
    'Now, save the file...
    mnuFileSave_Click
End Sub
Function OKtoNuke (mymsg As String) As Integer
    Dim rc As Integer
    Dim msgtype As Integer
    Dim msgtitle As String
    msgtype = YESNOCANCEL + WARNINGQUERY + FIRSTBUTTON
    msgtitle = "Save Changes?"
    'This function checks to see if the text has changed and then asks
    'if changes should be saved before exiting, opening another,
    'creating a new file, etc.
    'It returns TRUE  == OK to lose the changes or
    '            FALSE == not OK to lose the changes.
    If dirtyflag Then
        'File has changed, prompt user to save changes
        rc = MsgBox(mymsg, msgtype, msgtitle)

        'Check which button user pressed. Set OKtoNuke based on user choice
        Select Case rc
            Case KEYCANCEL  'cancel was pressed
                'Don't nuke the file
                OKtoNuke = False
            Case KEYYES      'yes was pressed
                mnuFileSave_Click
                OKtoNuke = Not dirtyflag
            Case KEYNO       'no was pressed
                'Nuke the file
                OKtoNuke = True
        End Select
    Else
        'The file has not changed, OK to Nuke it
        OKtoNuke = True
    End If
End Function
Sub txtEditor_Change ()
    'Set the change flag - changes have occurred
    dirtyflag = True
End Sub